home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / Alfresco / AAStStk.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-04-25  |  7.6 KB  |  251 lines
  1. {*********************************************************}
  2. {* AAStStk                                               *}
  3. {* Copyright (c) Julian M Bucknall 1998-1999             *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* String stack (based on ideas from GNU's ObStack)      *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAStStk;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils;
  19.  
  20. type
  21.   PaaString255 = ^TaaString255;
  22.   TaaString255 = string[255];
  23.  
  24. type
  25.   TaaStringStack = class
  26.     private
  27.       FChunkSize : integer;
  28.       FChunk     : PChar;
  29.       FCount     : integer;
  30.       FCurString : PChar;
  31.     protected
  32.       function ssGetChunkCount : integer;
  33.       function ssGetSlackSpace : integer;
  34.       procedure ssAddNewChunk;
  35.     public
  36.       constructor Create(aChunkSize : integer);
  37.         {-create the short string stack}
  38.       destructor Destroy; override;
  39.         {-destroy the short string stack; releasing all memory}
  40.  
  41.       procedure Clear;
  42.         {-remove all strings from stack}
  43.       function Examine : TaaString255;
  44.         {-return the top string from the stack without popping it}
  45.       function IsEmpty : boolean;
  46.         {-is the stack empty?}
  47.       function Pop : TaaString255;
  48.         {-pop the top string from the stack; return it}
  49.       function Push(const aSt : TaaString255) : PaaString255;
  50.         {-push the given string onto the stack; return its address on
  51.           the stack}
  52.  
  53.       property Count : integer read FCount;
  54.         {-the number of strings on the stack}
  55.  
  56.       property ChunkCount : integer read ssGetChunkCount;
  57.       property ChunkSize : integer read FChunkSize;
  58.       property SlackSpace : integer read ssGetSlackSpace;
  59.     end;
  60.  
  61. implementation
  62.  
  63. {Notes: FCurString acts as the stack pointer.
  64.         To push a string, FCurString is advanced past the current
  65.         string, and aligned to the nearest 4-byte boundary. The
  66.         routine then checks to see if the string being pushed can be
  67.         added to the remaining space in the chunk. If so, it is. If
  68.         not, a new chunk is allocated and the new string is added to
  69.         the beginning of that. The position of the new string on the
  70.         stack is returned.
  71.         To pop a string, the current string is returned and FCurString
  72.         is moved back to the previous string. If that is in another
  73.         chunk, the chunk just vacated is freed.}
  74.  
  75. type
  76.   PChunkHeader = ^TChunkHeader;
  77.   TChunkHeader = packed record
  78.     chLimit : PChar;
  79.     chPrev  : PChunkHeader;
  80.   end;
  81.  
  82. type
  83.   PStringNode = ^TStringNode;
  84.   TStringNode = packed record
  85.     snPrev   : PStringNode;
  86.     snString : TaaString255;
  87.   end;
  88.  
  89. const
  90.   {the minimum for the chunk size will hold a full 256 byte short
  91.    string, as well as the string node and chunk overhead}
  92.   MinChunkSize = 256 + sizeof(TChunkHeader) + sizeof(pointer);
  93.  
  94. {===TaaStringStack===================================================}
  95. constructor TaaStringStack.Create(aChunkSize : integer);
  96. begin
  97.   inherited Create;
  98.   if (aChunkSize < MinChunkSize) then
  99.     aChunkSize := MinChunkSize;
  100.   FChunkSize := aChunkSize;
  101. end;
  102. {--------}
  103. destructor TaaStringStack.Destroy;
  104. begin
  105.   Clear;
  106.   inherited Destroy;
  107. end;
  108. {--------}
  109. procedure TaaStringStack.Clear;
  110. var
  111.   Chunk : PChunkHeader;
  112.   Temp  : PChunkHeader;
  113. begin
  114.   Temp := PChunkHeader(FChunk);
  115.   while (Temp <> nil) do begin
  116.     Chunk := Temp^.chPrev;
  117.     FreeMem(Temp, (Temp^.chLimit - PChar(Temp)));
  118.     Temp := Chunk;
  119.   end;
  120.   FChunk := nil;
  121.   FCurString := nil;
  122.   FCount := 0;
  123. end;
  124. {--------}
  125. function TaaStringStack.Examine : TaaString255;
  126. begin
  127.   {check for the obvious mistake}
  128.   if (FCurString = nil) then
  129.     raise Exception.Create('TaaStringStack.Examine: the stack is empty');
  130.   {return the current string}
  131.   Result := PStringNode(FCurString)^.snString;
  132. end;
  133. {--------}
  134. function TaaStringStack.IsEmpty : boolean;
  135. begin
  136.   Result := (FCurString = nil);
  137. end;
  138. {--------}
  139. function TaaStringStack.Pop : TaaString255;
  140. var
  141.   Temp : PChar;
  142. begin
  143.   {check for the obvious mistake}
  144.   if (FCurString = nil) then
  145.     raise Exception.Create('TaaStringStack.Pop: the stack is empty');
  146.   {return the current string}
  147.   Result := PStringNode(FCurString)^.snString;
  148.   {move the current string pointer back, checking for switching
  149.    chunks where we need to free the chunk just left}
  150.   if (FChunk + sizeof(TChunkHeader) = FCurString) then begin
  151.     {we're leaving this chunk; set the current string pointer}
  152.     FCurString := PChar(PStringNode(FCurString)^.snPrev);
  153.     {reset the chunk address and dispose of the one just left}
  154.     Temp := FChunk;
  155.     FChunk := PChar(PChunkHeader(FChunk)^.chPrev);
  156.     FreeMem(Temp, FChunkSize);
  157.   end
  158.   else begin
  159.     {just move the current string pointer back}
  160.     FCurString := PChar(PStringNode(FCurString)^.snPrev);
  161.   end;
  162.   dec(FCount);
  163. end;
  164. {--------}
  165. function TaaStringStack.Push(const aSt : TaaString255) : PaaString255;
  166. var
  167.   PrevNode     : PStringNode;
  168.   NewCurString : PChar;
  169. begin
  170.   {save the current string node address}
  171.   PrevNode := PStringNode(FCurString);
  172.   {check for an empty stack}
  173.   if (FCurString = nil) then begin
  174.     if (FChunk = nil) then
  175.       ssAddNewChunk;
  176.   end
  177.   else begin
  178.     {advance the current string pointer}
  179.     NewCurString := PChar(PrevNode) +
  180.                     sizeof(pointer) +
  181.                     length(PrevNode^.snString) +
  182.                     2 {the length byte and the hidden end null};
  183.     {align the new pointer}
  184.     NewCurString := pointer((longint(NewCurString) + 3) and $FFFFFFFC);
  185.     {if there's not enough room for the new string, get a new chunk}
  186.     if (PChunkHeader(FChunk)^.chLimit - NewCurString) <
  187.                             (sizeof(pointer) + length(aSt) + 2) then
  188.       ssAddNewChunk
  189.     {otherwise, position the current string pointer}
  190.     else
  191.       FCurString := NewCurString;
  192.   end;
  193.   {set up the new node}
  194.   with PStringNode(FCurString)^ do begin
  195.     snPrev := PrevNode;
  196.     snString := aSt;
  197.     snString[length(aSt)+1] := #0;
  198.   end;
  199.   {return address of the pushed string}
  200.   Result := PaaString255(FCurString + sizeof(pointer));
  201.   inc(FCount);
  202. end;
  203. {--------}
  204. procedure TaaStringStack.ssAddNewChunk;
  205. var
  206.   NewChunk : PChar;
  207. begin
  208.   GetMem(NewChunk, FChunkSize);
  209.   PChunkHeader(NewChunk)^.chLimit := NewChunk + FChunkSize;
  210.   PChunkHeader(NewChunk)^.chPrev := PChunkHeader(FChunk);
  211.   FChunk := NewChunk;
  212.   FCurString := NewChunk + sizeof(TChunkHeader);
  213. end;
  214. {--------}
  215. function TaaStringStack.ssGetChunkCount : integer;
  216. var
  217.   Temp : PChunkHeader;
  218. begin
  219.   Result := 0;
  220.   Temp := PChunkHeader(FChunk);
  221.   while (Temp <> nil) do begin
  222.     inc(Result);
  223.     Temp := Temp^.chPrev;
  224.   end;
  225. end;
  226. {--------}
  227. function TaaStringStack.ssGetSlackSpace : integer;
  228. var
  229.   Temp : PChunkHeader;
  230.   Next : PChunkHeader;
  231.   Node : PStringNode;
  232.   StartSlack : PChar;
  233. begin
  234.   Result := 0;
  235.   if (FChunk <> nil) then begin
  236.     Next := PChunkHeader(FChunk);
  237.     Temp := Next^.chPrev;
  238.     while (Temp <> nil) do begin
  239.       Node := PStringNode(PChar(Next) + sizeof(TChunkHeader))^.snPrev;
  240.       StartSlack := PChar(Node) + sizeof(pointer) +
  241.                                   length(Node^.snString) + 2;
  242.       inc(Result, Temp^.chLimit - StartSlack);
  243.       Next := Temp;
  244.       Temp := Temp^.chPrev;
  245.     end;
  246.   end;
  247. end;
  248. {====================================================================}
  249.  
  250. end.
  251.